(in-package :nondestructive)

(eval-when (:compile-toplevel :load-toplevel :execute)
(defun expand-helper (x)
  "for some reason a macrolet macro can't use a labels/flet
function. So this helper function is for the define-transformation
macro."
  (if (listp x)
      `(:eval (format nil ,@x))
      x)))

(defmacro define-transformation (name &body body)
  (u:with-gensyms (condition)
    `(defun ,name (,condition)
       (macrolet ((m (full)
                    `(ecase ,',condition
                       ((:minimum :basic) "That is not the right value.")
                       (:full ',(expand-helper full))))
                  (h (min basic full)
                    `(ecase ,',condition
                       (:minimum ',(expand-helper min))
                       (:basic ',(expand-helper basic))
                       (:full ',(expand-helper full))))
                  (basic-mistake ()
                    `(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")))
         ,@body))))

(defun match-tree (tree template)
  (cond
    ((and (symbolp template)
          (string= template "?"))
     t)
    ((and (symbolp tree)
          (symbolp template))
     (string= tree template))
    ((and (listp tree)
          (listp template)
          (eql (length tree) (length template)))
     (every 'match-tree tree template))
    (t nil)))

(defun ditch-operator-inputs (transformation)
  (labels ((m (a b) (string= a b))
           (match (tree b)
             (m (first tree) b))
           (maybe-quote (sym)
             (if (find sym '(+ - / *))
                 `(quote ,sym)
                 sym))
           (augment-answer (answer op)
             (if (and (listp answer)
                      (eq (first answer) :eval))
                 `(:eval (funcall ,(maybe-quote op) ,@(last answer)))
                 `(:eval (funcall ,(maybe-quote op) ,answer))))
           (l (a b)
             (char= (char (string a) 0) (char (string b) 0)))
           (ditch (tree)
             (cond
               ((or (null tree)
                    (symbolp tree))
                tree)
               ((match tree 'm)
                (let ((r (copy-tree (list* (first tree) (mapcar #'ditch (cdr tree))))))
                  (cond
                    ;; subtracting a multiplication
                    ((match-tree r '(m ? (a a) (a nil (m (ni nil :mistake ? :hint ? :answer ?) (a *) ?))))
                     (let ((answer (getf (cddr (second (third (fourth r)))) :answer))
                           (op (second (third r))))
                       (setf (second (third r)) '+
                             (getf (cddr (second (third (fourth r)))) :answer) (augment-answer answer op))))
                    ((match-tree r '(m ? (a a) (ni nil :mistake ? :hint ? :answer ?)))
                     (let ((answer (getf (cddr (fourth r)) :answer))
                           (op (second (third r))))
                       (setf (second (third r)) '+
                             (getf (cddr (fourth r)) :answer) (augment-answer answer op))))
                    ((match-tree r '(m ? (a -) (a nil (m (i nil :answer ?) (a *) ?))))
                     (let ((answer (getf (cddr (second (third (fourth r)))) :answer))
                           (op (second (third r))))
                       (setf (second (third r)) '+
                             (getf (cddr (second (third (fourth r)))) :answer) (augment-answer answer op)))))
                  r))
               ((match tree 'a)
                (list* (first tree) (second tree) (ditch (third tree)) (cdddr tree)))
               ((or (match tree 'ni)
                    (match tree 'i))
                tree)
               ((match tree 'oi)
                (list 'a (or (find-symbol (getf (cddr tree) :answer))
                             (getf (cddr tree) :answer))))
               (t (error "dunno ~a" (first tree))))))
    (setf (o:new-tree transformation) (ditch (o:new-tree transformation)))
    transformation))

(defmacro doi (x)
  `(ditch-operator-inputs ,x))

(define-transformation nd-evaluate-transformations
  (list
   (make-instance 'o:transformation
                  :old-tree '(a nil (m (a n1 w1) (a op) (a n2 w2) :store x) :selected t)
                  :new-tree `(i nil x
                                  :hint ,(h "Enter a number."
                                           ("Enter ~a." (funcall op n1 n2))
                                           ("The ~a of ~a and ~a flows into this tile. The ~a is ~a. Enter it."
                                            (ecase op (+ "sum") (- "difference") (* "product") (/ "quotient")) n1 n2
                                            (ecase op (+ "sum") (- "difference") (* "product") (/ "quotient")) (funcall op n1 n2)))
                                  :mistake ,(h "That is the wrong number."
                                              "That is the wrong number."
                                              ("That is not the ~a of ~a and ~a. ~a ~a ~a = ~a."
                                               (ecase op (+ "sum") (- "difference") (* "product") (/ "quotient"))
                                               n1 n2
                                               n1 op n2 (funcall op n1 n2)))
                                  :answer (:eval (funcall op n1 n2)))
                  :hint (h "click a tile."
                           "Click this box to fill it in."
                           "You can calculate the value for this tile from the values above.  Click it.")
                  :reward 2 ; used by in linearize
                  :surgeryp nil)
   (make-instance 'o:transformation
                  :old-tree '(a nil (m (a n1 w) :store x) :selected t)
                  :new-tree `(i nil x
                                  :hint ,(h "Enter a number."
                                           ("Enter ~a." n1)
                                           ("The number ~a flows into this tile. Enter it." n1))
                                  :mistake ,(h "That is the wrong number."
                                              "That is the wrong number."
                                              "That is the wrong number.")
                                  :answer n1)
                  :hint (h "click a tile."
                           "Click this tile to fill it in."
                           "You can calculate the value of this tile from the value above. Click it.")
                  :reward 1 ; used by in linearize
                  :surgeryp nil)
   (make-instance 'o:transformation
                  :old-tree '(a nil w (m (a n1) :store x) :selected t)
                  :new-tree `(i nil w x
                                  :hint ,(h "Enter a number."
                                           ("Enter ~a." n1)
                                           ("The number ~a flows into this tile. Enter it." n1))
                                  :mistake ,(h "That is the wrong number."
                                              "That is the wrong number."
                                              "That is the wrong number.")
                                  :answer n1)
                  :hint (h "click a tile."
                           "Click this tile to fill it in."
                           "You can calculate the value of this tile from the value above. Click it.")
                  :reward 1 ; used by in linearize
                  :surgeryp nil)))

(define-transformation nd-invert-transformations
  (labels ((not-zero (v vars)
             (not (zerop (second (find v vars :key 'first)))))
           (n1-not-zero (trans root vars)
             (declare (ignore trans root))
             (not-zero 'n1 vars))
           (n2-not-zero (trans root vars)
             (declare (ignore trans root))
             (not-zero 'n2 vars))
           (both-not-zero (trans root vars)
             (declare (ignore trans root))
             (and (not-zero 'n1 vars)
                  (not-zero 'n2 vars))))
    (let ((trans-hint (h "Click a tile."
                         "Click this box to fill it in."
                         "You can calculate the value for this tile from the value next to it and the value below."))
          (x-hint (h "Click a tile."
                     "Click this box to fill it in."
                     "You can calculate the value of this tile from the value below. Click it."))
          (mistake (h "You cannot click that box."
                      "You cannot click that box."
                      "You are not ready to calculate the value of that tile, but you can calculate the value of this tile from the value next to it and the value below.")))
      (list*
       (make-instance 'o:recon
                      :old-tree '(a n (m (a nil w :selected t :store arg)))
                      :root 'arg
                      :new-tree `(i nil w
                                        :mistake ,(m ("That number is not ~d." n))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." n)
                                                  ("Copy the number below into the tile. Enter ~a." n))
                                        :answer n
                                        :input-location :above)
                      :hint x-hint
                      :mistake mistake
                      :reward 1 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n (m (a nil w2 :selected t :store arg)) w)
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("That number is not ~d." n))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." n)
                                                  ("Copy the number below into the tile. Enter ~a." n))
                                        :answer n
                                        :input-location :above)
                      :hint x-hint
                      :mistake mistake
                      :reward 1 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n w (m (a nil w2 :selected t :store arg)))
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("That number is not ~d." n))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." n)
                                                  ("Copy the number below into the tile. Enter ~a." n))
                                        :answer n
                                        :input-location :above)
                      :hint x-hint
                      :mistake mistake
                      :reward 1 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n1 (m (a nil w2 :store arg :selected t) (a *) (a n2 w)))
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("that times ~a is not ~a." n2 n1))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." (/ n1 n2))
                                                  ("This number times ~a equals ~a in the tile below. ~a*~a=~a. Enter ~a." n2 n1 (/ n1 n2) n2 n1 (/ n1 n2)))
                                        :answer (:eval (/ n1 n2))
                                        :input-location :above)
                      :check-function #'n2-not-zero
                      :hint trans-hint
                      :mistake mistake
                      :reward 3 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n1 (m (a n2 w) (a *) (a nil w2 :store arg :selected t)))
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("That times ~a is not ~a." n2 n1))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." (/ n1 n2))
                                                  ("~a times this number equals ~a in the tile below. ~a*~a=~a. Enter ~a." n2 n1 n2 (/ n1 n2) n1 (/ n1 n2)))
                                        :answer (:eval (/ n1 n2))
                                        :input-location :above)
                      :check-function #'n2-not-zero
                      :hint trans-hint
                      :mistake mistake
                      :reward 3 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n1 (m (a nil w2 :store arg :selected t) (a +) (a n2 w)))
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("That plus ~a is not ~a." n2 n1))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." (- n1 n2))
                                                  ("This number plus ~a equals ~a in the tile below. ~a+~a=~a. Enter ~a." n2 n1 (- n1 n2) n2 n1 (- n1 n2)))
                                        :answer (:eval (- n1 n2))
                                        :input-location :above)
                      :hint trans-hint
                      :mistake mistake
                      :reward 3 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n1 (m (a n2 w) (a +) (a nil w2 :store arg :selected t)))
                      :root 'arg
                      :new-tree `(i nil w2 
                                        :mistake ,(m ("~a plus that is not ~a." n2 n1))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." (- n1 n2))
                                                  ("~a plus this number equals ~a in the tile below. ~a+~a=~a. Enter ~a." n2 n1 n2 (- n1 n2) n1 (- n1 n2)))
                                        :answer (:eval (- n1 n2))
                                        :input-location :above)
                      :hint trans-hint
                      :mistake mistake
                      :reward 3 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n1 (m (a nil w2 :store arg :selected t) (a -) (a n2 w)))
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("That minus ~a is not ~a." n2 n1))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." (+ n1 n2))
                                                  ("This number minus ~a equals ~a in the tile below. ~a-~a=~a. Enter ~a." n2 n1 (+ n1 n2) n2 n1 (+ n1 n2)))
                                        :answer (:eval (+ n1 n2))
                                        :input-location :above)
                      :hint trans-hint
                      :mistake mistake
                      :reward 3 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n1 (m (a n2 w) (a -) (a nil w2 :store arg :selected t)))
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("~a minus that is not ~a." n2 n1))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." (- n2 n1))
                                                  ("~a minus this number equals ~a in the tile below. ~a-~a=~a. Enter ~a." n2 n1 n2 (- n2 n1) n1 (- n2 n1)))
                                        :answer (:eval (- n2 n1))
                                        :input-location :above)
                      :hint trans-hint
                      :mistake mistake
                      :reward 3 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n1 (m (a nil w2 :store arg :selected t) (a /) (a n2 w)))
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("That divided by ~a is not ~a." n2 n1))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." (* n1 n2))
                                                  ("This number divided by ~a equals ~a in the tile below. ~a/~a=~a. Enter ~a." n2 n1 (* n1 n2) n2 n1 (* n1 n2)))
                                        :answer (:eval (* n1 n2))
                                        :input-location :above)
                      :check-function #'n2-not-zero
                      :hint trans-hint
                      :mistake mistake
                      :reward 3 ; used by in linearize
                      :surgeryp nil)
       (make-instance 'o:recon
                      :old-tree '(a n1 (m (a n2 w) (a /) (a nil w2 :store arg :selected t)))
                      :root 'arg
                      :new-tree `(i nil w2
                                        :mistake ,(m ("~a divided by that is not ~a." n2 n1))
                                        :hint ,(h "Enter a number."
                                                  ("Enter ~a." (/ n2 n1))
                                                  ("~a divided by this number equals ~a in the tile below. ~a/~a=~a. Enter ~a." n2 n1 n2 (/ n2 n1) n1 (/ n2 n1)))
                                        :answer (:eval (/ n2 n1))
                                        :input-location :above)
                      :check-function #'both-not-zero
                      :hint trans-hint
                      :mistake mistake
                      :reward 3 ; used by in linearize
                      :surgeryp nil)
       (labels ((sqrt-rule (side)
                  (make-instance 'o:recon
                                 :old-tree (if (eq side :left)
                                             '(a n1 (m (a nil b :selected t :store arg) (a *) (a _ b)))
                                             '(a n1 (m (a _ b) (a *) (a nil b :selected t :store arg))))
                                 :root 'arg
                                 :new-tree `(i nil b
                                                   :mistake ,(m ("That times itself is not ~a." n1))
                                                   :hint ,(h "Enter a number."
                                                             ("Enter ~a." (isqrt n1))
                                                             ("What number times itself is ~a? Enter ~a." n1 (isqrt n1)))
                                                   :answer (isqrt n1)
                                                   :input-location :above)
                                 :hint trans-hint
                                 :mistake mistake
                                 :reward 3 ; used by in linearize
                                 :surgeryp nil)))
         (list
          (sqrt-rule :left)
          (sqrt-rule :right)))))))

(define-transformation nd-basic-combine
  (macrolet ((rule (rule result &key answer (full `("Click this box and type ~a" ,(cdr answer))) (hint 'trans-hint) (mistake 'trans-mistake))
               `(o::add-plists (doi (o::rule ',rule ',(substitute answer 'answer result)
                                                     :hint ,hint :mistake ,mistake))
                                   `(:mistake ,(basic-mistake)
                                              :hint ,(h "Enter a number to complete the box"
                                                        ("Click this box and type ~a" ,(cdr answer))
                                                        ,full)))))
    (let ((trans-hint (h "Click some boxes and an operator."
                         "Click the boxes pointed to by the green arrows and select Combine Multiplicative Operations."
                         "The numbers in two multiplication boxes can be combined. Click the boxes pointed to by the green arrows and select Combine Multiplicative Operations."))
          (trans-mistake (h "You cannot apply an operator to these boxes."
                            "You cannot apply that operator to those boxes."
                            "These boxes cannot be combined. They are not connected boxes that involve multiplication and two numbers.")))
      (list
       (rule (n1 + (n2 + b)) (answer + b) :answer (:eval + n1 n2))
       (rule (n1 + (b + n2)) (answer + b) :answer (:eval + n1 n2))
       (rule ((n2 + b) + n1) (answer + b) :answer (:eval + n1 n2))
       (rule ((b + n2) + n1) (answer + b) :answer (:eval + n1 n2))
       ;; +-
       (rule (n1 + (n2 - b)) (answer - b) :answer (:eval + n1 n2))
       (rule ((n2 - b) + n1) (answer - b) :answer (:eval + n1 n2))
       (rule (n1 + (b - n2)) (answer + b) :answer (:eval + (- n2) n1))
       (rule ((b - n2) + n1) (answer + b) :answer (:eval + (- n2) n1))
       ;; -+
       (rule (n1 - (n2 + b)) (answer - b) :answer (:eval - n1 n2))
       (rule (n1 - (b + n2)) (answer - b) :answer (:eval - n1 n2))
       (rule ((n2 + b) - n1) (answer + b) :answer (:eval - n2 n1))
       ;; FIXME: The box is on the left for this one. There is no reason
       ;; for it other than that its always been this way.
       (rule ((b + n2) - n1) (b + answer) :answer (:eval - n2 n1))
       ;; --
       (rule ((n2 - b) - n1) (answer - b) :answer (:eval - n2 n1))
       (rule ((b - n2) - n1) (b + answer) :answer (:eval - (- n2) n1))
       (rule (n1 - (n2 - b)) (answer + b) :answer (:eval - n1 n2))
       (rule (n1 - (b - n2)) (answer - b) :answer (:eval - n1 (- n2)))
       ;; **
       (rule (n1 * (n2 * b)) (answer * b) :answer (:eval * n1 n2))
       (rule (n1 * (b * n2)) (answer * b) :answer (:eval * n1 n2))
       (rule ((n2 * b) * n1) (answer * b) :answer (:eval * n1 n2))
       (rule ((b * n2) * n1) (answer * b) :answer (:eval * n1 n2))
       ;; */
       (rule ((n2 * b) / n1) (answer * b) :answer (:eval / n2 n1))
       (rule ((b * n2) / n1) (answer * b) :answer (:eval / n1 n2))
       (rule (n1 / (n2 * b)) (answer / b) :answer (:eval / n1 n2))
       (rule (n1 / (b * n2)) (answer / b) :answer (:eval / n1 n2))
       ;; /*
       (rule ((n2 / b) * n1) (answer / b) :answer (:eval * n2 n1))
       (rule ((b / n2) * n1) (b * answer) :answer (:eval / n1 n2))
       (rule (n1 * (n2 / b)) (answer / b) :answer (:eval * n2 n1))
       (rule (n1 * (b / n2)) (answer * b) :answer (:eval / n1 n2))))))

(defun print-box (box)
  (cond
    ((eql (length (tree:children box)) 3)
     (format nil "~{~a~}" (remove nil (mapcar 'd:quantity (tree:children box)))))
    ((and (eql (length (tree:children box)) 1)
          (null (d:quantity (first (tree:children box)))))
     (format nil "top"))
    (t (error "gaaaah! how does i the printzess this boxenz0r?"))))

(defun expand-rule (rule)
  "When multiple rules have the same answer, use this to generate all the rules."
  (labels ((enumerate (list)
             (if (null list)
                 (list (list))
                 (loop for i in (first list)
                    append (loop for j in (enumerate (rest list))
                              collect (list* i j))))))
    (cond
      ((symbolp rule)
       (list rule))
      ((listp rule)
       (if (find (second rule) '(++ ** -- //))
           (let ((op (find-symbol (string (char (string (second rule)) 0)))))
             (append
              (enumerate (mapcar 'expand-rule (list (first rule)
                                                    op
                                                    (third rule))))
              (enumerate (mapcar 'expand-rule (list (third rule)
                                                    op
                                                    (first rule))))))
           (enumerate (mapcar 'expand-rule rule))))
      (t (error "dunno how to expand ~s" rule)))))

(define-transformation new-switch-1
  (macrolet ((hint (thing)
               `(h "Enter a number to complete a box."
                   ("Click this box and type ~a." ,thing)
                   ("Click this box and type ~a." ,thing)))
             (hints (n1 n2 n3 &optional reversed)
               ``((,(hint ,n1) ,(hint ,(if reversed n3 n2)) ,(hint ,(if reversed n2 n3)))
                    (,(hint ,n1) ,(hint ,n3))
                    (,(hint ,n1) ,(hint ,n2))
                    (,(hint ,n1)))))
    (let ((trans-hint (h "Click some boxes and an operator."
                         "Click the boxes pointed to by the green arrows and select Switch Additive Operations."
                         "The order of two additions or subtractions can be switched. Click the boxes pointed to by the green arrows and select Switch Additive Operations."))
          (trans-mistake (h "You cannot apply an operator to these boxes."
                            "You cannot apply that operator to those boxes."
                            "These boxes cannot be switched. They are not connected boxes that involve addition and subtraction.")))
  (labels ((odd-forms (rule)
             (list rule
                   (u:subst-tree (lambda (x) (and (listp x) (eq (third x) 'b1))) 'b1 rule :test 'equal)
                   (u:subst-tree (lambda (x) (and (listp x) (eq (third x) 'b2))) 'b2 rule :test 'equal)
                   (u:subst-tree (lambda (l)
                                   (or (and (listp l) (eq (third l) 'b1))
                                       (and (listp l) (eq (third l) 'b2))))
                                 'third
                                 rule)))
           (filter-special-cases (rule)
             (cond
               ((equal rule '(n1 + (((:eval - n2) * b1) + ((:eval - n3) * b2))))
                '((n1 + (((:eval - n2) * b1) + ((:eval - n3) * b2)))
                  (n1 + (((:eval - n3) * b2) - b1))
                  (n1 + (((:eval - n2) * b1) - b2))
                  (n1 + (b2 - b1))))
               (t (odd-forms rule))))
           (expand (rule result &key (hint trans-hint) (mistake trans-mistake) hints (plists (loop for i in hints
                                                                                              collect `(:mistake ,(basic-mistake) :hint ,i))))
             (loop for i in (expand-rule rule)
                for rule = (apply 'o::add-plists
                                  (doi (o::rule i result :hint hint :mistake mistake))
                                  plists)
                  do (setf (o:old-tree rule) (o::walk-tree (o:old-tree rule)
                                                             (lambda (x)
                                                               (if (and (listp x)
                                                                        (string= (first x) :m)
                                                                        (eq (second (third x)) '*))
                                                                   (progn
                                                                     (setf (getf (cddddr x) :selected) nil)
                                                                     x)
                                                                   x))))
                collect rule))
           (rule (rule result hints)
             (loop
                for a in (odd-forms rule)
                for b in (filter-special-cases result)
                for c in hints
                append (expand a b :hints c))))
     (nconc
      (rule '((n1 + (n2 ** b1)) + (n3 ** b2))
            '(n1 + ((n2 * b1) + (n3 * b2)))
            (hints n1 n2 n3))
      (rule '(((n2 ** b1) + n1) + (n3 ** b2))
            '(((n2 * b1) + (n3 * b2)) + n1)
            (hints n1 n2 n3))
      (rule '((n3 ** b2) + (n1 + (n2 ** b1)))
            '(n1 + ((n3 * b2) + (n2 * b1)))
            (hints n1 n2 n3 t))
      (rule '((n3 ** b2) + ((n2 ** b1) + n1))
            '(((n3 * b2) + (n2 * b1)) + n1)
            (hints n1 n2 n3))

      (rule '((n1 + (n2 ** b1)) - (n3 ** b2))
            '(n1 + ((n2 * b1) - (n3 * b2)))
            (hints n1 n2 (- n3)))
      (rule '(((n2 ** b1) + n1) - (n3 ** b2))
            '(((n2 * b1) - (n3 * b2)) + n1)
            (hints n1 n2 (- n3)))
      (rule '((n3 ** b2) - (n1 + (n2 ** b1)))
            '(((n3 * b2) - (n2 * b1)) + (:eval - n1))
            (hints (- n1) (- n2) n3 t))
      (rule '((n3 ** b2) - ((n2 ** b1) + n1))
            '(((n3 * b2) - (n2 * b1)) + (:eval - n1))
            (hints (- n1) (- n2) n3 t))

      (rule '((n1 - (n2 ** b1)) + (n3 ** b2))
            '(n1 + (((:eval - n2) * b1) + (n3 * b2)))
            (hints n1 (- n2) n3 t))
      (rule '(((n2 ** b1) - n1) + (n3 ** b2))
            '(((n2 * b1) + (n3 * b2)) + (:eval - n1))
            (hints (- n1) n2 n3 t))
      (rule '((n3 ** b2) + (n1 - (n2 ** b1)))
            '(((n3 * b2) - (n2 * b1)) + n1)
            (hints n1 (- n2) n3 t))
      (rule '((n3 ** b2) + ((n2 ** b1) - n1))
            '(((n3 * b2) + (n2 * b1)) + (:eval - n1))
            (hints (- n1) n2 n3 t))

      (rule '((n1 - (n2 ** b1)) - (n3 ** b2))
            '(n1 + (((:eval - n2) * b1) + ((:eval - n3) * b2)))
            (hints n1 (- n2) (- n3)))
      (rule '(((n2 ** b1) - n1) - (n3 ** b2))
            '(((n2 * b1) - (n3 * b2)) + (:eval - n1))
            (hints (- n1) n2 (- n3)))
      (rule '((n3 ** b2) - (n1 - (n2 ** b1)))
            '(((n3 * b2) + (n2 * b1)) + (:eval - n1))
            (hints (- n1) n2 n3 t))
      (rule '((n3 ** b2) - ((n2 ** b1) - n1))
            '(((n3 * b2) - (n2 * b1)) + n1)
            (hints n1 (- n2) n3 t)))))))

(define-transformation new-switch-2
  (macrolet ((hint (thing)
               `(h "Enter a number to complete a box."
                  ("Click this box and type ~a." ,thing)
                  ("Click this box and type ~a." ,thing))))
    (let ((trans-hint (h "Click some boxes and an operator."
                         "Click the boxes pointed to by the green arrows and select Switch Additive Operations."
                         "The order of two additions or subtractions can be switched. Click the boxes pointed to by the green arrows and select Switch Additive Operations."))
          (trans-mistake (h "You cannot apply an operator to these boxes."
                            "You cannot apply that operator to those boxes."
                            "These boxes cannot be switched. They are not connected boxes that involve addition and subtraction.")))
  (labels ((rule (rule result &key (hint trans-hint) (mistake trans-mistake) hints (plists (loop for i in hints
                                                                                              collect `(:mistake ,(basic-mistake) :hint ,i))))

             (loop for i in (expand-rule rule) collect 
                  (apply 'o::add-plists
                         (doi (o::rule i result :hint hint :mistake mistake))
                         plists))))
     (nconc
      (rule '((n1 + b1) + b2)
            '(n1 + (b1 + b2))
            :hints `(,(hint n1)))
      (rule '((b1 + n1) + b2)
            '((b1 + b2) + n1)
            :hints `(,(hint n1)))
      (rule '(b2 + (n1 + b1))
            '(n1 + (b2 + b1))
            :hints `(,(hint n1)))
      (rule '(b2 + (b1 + n1))
            '((b2 + b1) + n1)
            :hints `(,(hint n1)))
                
      (rule '((n1 + b1) - (n3 ** b2))
            '(n1 + (b1 - (n3 * b2)))
            :hints `(,(hint n1) ,(hint (- n3))))
      (rule '((b1 + n1) - (n3 ** b2))
            '((b1 - (n3 * b2)) + n1)
            :hints `(,(hint n1) ,(hint (- n3))))
      (rule '(b2 - (n1 + (n2 ** b1)))
            '((b2 - (n2 * b1)) + (:eval - n1))
            :hints `(,(hint (- n1)) ,(hint (- n2))))
      (rule '(b2 - ((n2 ** b1) + n1))
            '((b2 - (n2 * b1)) + (:eval - n1))
            :hints `(,(hint (- n1)) ,(hint (- n2))))

      (rule '((n1 - (n2 ** b1)) + b2)
            '(n1 + (((:eval - n2) * b1) + b2))
            :hints `(,(hint n1) ,(hint (- n2))))
      (rule '((b1 - n1) + b2)
            '((b1 + b2) + (:eval - n1))
            :hints `(,(hint (- n1))))
      (rule '(b2 + (n1 - (n2 ** b1)))
            '((b2 - (n2 * b1)) + n1)
            :hints `(,(hint (- n1)) ,(hint (- n2))))
      (rule '(b2 + (b1 - n1))
            '((b2 + b1) + (:eval - n1))
            :hints `(,(hint (- n1))))
                
      (rule '((n1 - (n2 ** b1)) - (n3 ** b2))
            '(n1 - (((:eval - n2) * b1) + ((:eval - n3) * b2)))
            :hints `(,(hint n1) ,(hint (- n2)) ,(hint (- n3))))
      (rule '((b1 - n1) - (n3 ** b2))
            '((b1 - (n3 * b2)) + (:eval - n1))
            :hints `(,(hint (- n1)) ,(hint (- n3))))
      (rule '(b2 - (n1 - (n2 ** b1)))
            '((b2 + (n2 * b1)) + (:eval - n1))
            :hints `(,(hint (- n1)) ,(hint n2)))
      (rule '(b2 - ((n2 ** b1) - n1))
            '((b2 - (n2 * b1)) + n1)
            :hints `(,(hint n1) ,(hint (- n2)))))))))
   
(define-transformation nd-switch-transformations
  (let ((ophint (h
                 "Click a box and enter an operator."
                 "Click this box and type +."
                 ("How can you combine the ~a and ~a boxes to keep their sign the same in the original diagram? Click this box and type +." (print-box b1) (print-box b2))))
        (ophint2 (h
                  "Click a box and enter an operator."
                  "Click this box and type -."
                  ("How can you combine the ~a and ~a boxes to keep their sign the same in the original diagram? Click this box and type -." (print-box b1) (print-box b2))))
        (opmistake (h ""
                      "No."
                      "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram."))
        (hint1-num (h
                    "Enter a number to complete a box."
                    ("Click this box and type ~a." n1)
                    ("Click this box and type ~a." n1)))
        (hint1-op (h
                   "Enter an operator to complete a box."
                   "Click this box and type +."
                   ("Is ~a in the original diagram added or subtracted to produce the final result? Click this box and type +." n1)))
;;         (hint2-num (h
;;                     "Enter a number and an operator to complete a box."
;;                     ("Click this box and type ~a" n1)
;;                     ("Click this box and type ~a." n1)))
        (hint2-op (h
                   "Enter a number and an operator to complete a box."
                   "Click this box and type -"
                   ("Is ~a in the original diagram added or subtracted to produce the final result? Click this box and type -." n1)))
        (hint3-num (h
                    "Enter a number and an operator to complete a box."
                    ("Click this box and type ~a" n1)
                    ("Click this box and type ~a" n1)))
        (hint3-op (h
                   "Enter a number and an operator to complete a box."
                   "Click this box and type -"
                   ("Is ~a in the original diagram followed by an addition or subtraction to produce the final result? Click this box and type -." n1)))
        (mistake1 (h ""
                     "No."
                     "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram."))
        (trans-hint (h "Click some boxes and an operator."
                       "Click the boxes pointed to by the green arrows and select Switch Additive Operations."
                       "The order of two additions or subtractions can be switched. Click the boxes pointed to by the green arrows and select Switch Additive Operations."))
        (trans-mistake (h "You cannot apply an operator to these boxes."
                          "You cannot apply that operation to those boxes."
                          "These boxes cannot be switched. They are not connected boxes that involve addition and subtraction.")))
    (list
     (doi (make-instance 'o:transformation
                    :old-tree `(m (a nil (m (a n1) (a +) (a nil b1) :selected t)) (a +) (a nil b2) :selected t)
                    :new-tree `(m (a nil (m (a nil b1) (oi nil
                                                               :mistake ,opmistake
                                                               :hint ,ophint
                                                               :input-location :above
                                                               :answer "+") (a nil b2)))
                                      (oi nil
                                          :mistake ,mistake1
                                          :hint ,hint1-op
                                          :answer "+")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree `(m (a nil b2) (a +) (a nil (m (a nil b1) (a +) (a n1) :selected t)) :selected t)
                    :new-tree `(m (a nil (m (a nil b2) (oi nil
                                                               :mistake ,opmistake
                                                               :input-location :above
                                                               :hint ,ophint :answer "+") (a nil b1))) (oi nil
                                                                                                            :mistake ,mistake1
                                                                                                            :hint ,hint1-op
                                                                                                            :answer "+")
                                                               (ni nil
                                                                   :mistake ,mistake1
                                                                   :hint ,hint1-num
                                                                   :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil (m (a nil b1) (a +) (a n1) :selected t)) (a +) (a nil b2) :selected t)
                    :new-tree `(m (a nil (m (a nil b1) (oi nil :mistake ,opmistake :hint ,ophint :answer "+" :input-location :above) (a nil b2))) (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "+")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil b2) (a +) (a nil (m (a n1) (a +) (a nil b1) :selected t)) :selected t)
                    :new-tree `(m (a nil (m (a nil b1) (oi nil :mistake ,opmistake :hint ,ophint :answer "+" :input-location :above) (a nil b2))) (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "+")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil b2) (a +) (a nil (m (a n1) (a -) (a nil b1) :selected t)) :selected t)
                    :new-tree `(m (a nil (m (a nil b2) (oi nil :mistake ,opmistake :hint ,ophint2 :answer "-" :input-location :above) (a nil b1))) (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "+")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil (m (a nil b1) (a -) (a n1) :selected t)) (a -) (a nil b2) :selected t)
                    :new-tree `(m (a nil (m (a nil b1) (oi nil :mistake ,opmistake :hint ,ophint2 :answer "-" :input-location :above) (a nil b2))) (oi nil :mistake ,mistake1 :hint ,hint2-op :answer "-")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil (m (a nil b1) (a +) (a n1) :selected t)) (a -) (a nil b2) :selected t)
                    :new-tree `(m (a nil (m (a nil b1) (oi nil :mistake ,opmistake :hint ,ophint2 :answer "-" :input-location :above) (a nil b2))) (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "+")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil (m (a n1) (a +) (a nil b1) :selected t)) (a -) (a nil b2) :selected t)
                    :new-tree `(m (ni nil :mistake ,mistake1 :hint ,hint1-num :answer n1) (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "+") (a nil (m (a nil b1) (oi nil :mistake ,opmistake :hint ,ophint2 :answer "-" :input-location :above) (a nil b2))))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil (m (a n1) (a -) (a nil b1) :selected t)) (a +) (a nil b2) :selected t)
                    :new-tree `(m (ni nil :mistake ,mistake1 :hint ,hint3-num :answer n1) (oi nil :mistake ,mistake1 :hint ,hint3-op :answer "-") (a nil (m (a nil b1) (oi nil :mistake ,opmistake :hint ,ophint2 :answer "-" :input-location :above) (a nil b2))))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil (m (a n1) (a -) (a nil b1) :selected t)) (a -) (a nil b2) :selected t)
                    :new-tree `(m (ni nil :mistake ,mistake1 :hint ,hint3-num :answer n1) (oi nil :mistake ,mistake1 :hint ,hint3-op :answer "-") (a nil (m (a nil b1) (oi nil :mistake ,opmistake :hint ,ophint :answer "+" :input-location :above) (a nil b2))))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil b2) (a +) (a nil (m (a nil b1) (a -) (a n1) :selected t)) :selected t)
                    :new-tree `(m (a nil (m (a nil b2) (oi nil :mistake ,opmistake :hint ,ophint :answer "+" :input-location :above) (a nil b1))) (oi nil :mistake ,mistake1 :hint ,hint2-op :answer "-")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil b2) (a -) (a nil (m (a n1) (a -) (a nil b1) :selected t)) :selected t)
                    :new-tree `(m (a nil (m (a nil b2) (oi nil :mistake ,opmistake :hint ,ophint :answer "+" :input-location :above) (a nil b1)))
                                      (oi nil :mistake ,mistake1 :hint ,hint2-op :answer "-")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil b2) (a -) (a nil (m (a nil b1) (a -) (a n1) :selected t)) :selected t)
                    :new-tree `(m (a nil (m (a nil b2) (oi nil :mistake ,opmistake :hint ,ophint2 :answer "-" :input-location :above) (a nil b1)))
                                      (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "+")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil (m (a nil b1) (a -) (a n1) :selected t)) (a +) (a nil b2) :selected t)
                    :new-tree `(m (a nil (m (a nil b1) (oi nil :mistake ,opmistake :hint ,ophint :answer "+" :input-location :above) (a nil b2))) (oi nil :mistake ,mistake1 :hint ,hint2-op :answer "-")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer  n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil b2) (a -) (a nil (m (a nil b1) (a +) (a n1) :selected t)) :selected t)
                    :new-tree `(m (a nil (m (a nil b2) (oi nil :mistake ,opmistake :hint ,ophint2 :answer "-" :input-location :above) (a nil b1)))
                                      (oi nil :mistake ,mistake1 :hint ,hint2-op :answer "-")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree '(m (a nil b2) (a -) (a nil (m (a n1) (a +) (a nil b1) :selected t)) :selected t)
                    :new-tree `(m (a nil (m (a nil b2) (oi nil :mistake ,opmistake :hint ,ophint2 :answer "-" :input-location :above) (a nil b1)))
                                      (oi nil :mistake ,mistake1 :hint ,hint2-op :answer "-")
                                      (ni nil
                                          :mistake ,mistake1
                                          :hint ,hint1-num
                                          :answer n1))
                    :hint trans-hint
                    :mistake trans-mistake)))))

(define-transformation nd-reorder-transformations
  (let ((hint1-num (h "Click this box and enter a number."
                  ("Click this box and type ~a." n1)
                  ("How many times is the the input box multiplied in the original diagram? Click this box and type ~a." n1)))
        (hint1-op (h "Click this box and enter an operator."
                  "Click this box and type *."
                  ("Copy the multiplication operator? Click this box and type *." n1)))
        (mistake1 (h ""
                     "No."
                     "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram."))
        (hint2-num (h "Enter a number to complete the box."
                      ("Click this box and type ~a." (* n1 n2))
                      ("What happens to the ~a in the original box when it is multiplied by ~a? Click this box and type ~a." n2 n1 (* n1 n2))))
        (hint2-op (h "Enter an operator to complete the box."
                     ("Click this box and type ~a." a)
                     ("Was the top box added or substracted to ~a? Click this box and type ~a." n1 a)))
        (mistake2 (h ""
                     "No."
                     "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram."))
        (trans-hint (h "Click some boxes and an operator."
                       "Click the boxes pointed to by the green arrows and select Multiply Additive Input."
                       "When + or - box feeds into a * box you can reorder these boxes by multiplying the values in the * box. Click the boxes pointed to by the green arrows and select Multiply Additive Input."))
        (trans-mistake (h "You cannot apply that operation to those boxes."
                          "You cannot apply that operation to those boxes."
                          "These boxes cannot be reordered. They do not involve a + or - box feeding into a * box.")))
    (list
     (doi (make-instance 'o:transformation
                    :old-tree (o::c t '(n1 * (n2 a b)))
                    :new-tree `(m (ni nil :mistake ,mistake2 :hint ,hint2-num :answer (:eval (* n1 n2)) :input-location :above)
                                      (oi nil :mistake ,mistake2 :hint ,hint2-op :answer a :input-location :above)
                                      (a nil (m (ni nil :mistake ,mistake1 :hint ,hint1-num :answer n1) (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "*") (a nil b))))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree (o::c t '((n2 a b) * n1))
                    :new-tree `(m (ni nil :mistake ,mistake2 :hint ,hint2-num :answer (:eval (* n1 n2)) :input-location :above)
                                      (oi nil :mistake ,mistake2 :hint ,hint2-op :answer a :input-location :above)
                                      (a nil (m (ni nil :mistake ,mistake1 :hint ,hint1-num :answer n1) (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "*") (a nil b))))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree (o::c t '(n1 * (b a n2)))
                    :new-tree `(m (a nil (m (ni nil :mistake ,mistake1 :hint ,hint1-num :answer n1 :input-location :above)
                                                (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "*" :input-location :above)
                                                (a nil b)))
                                      (oi nil :mistake ,mistake2 :hint ,hint2-op :answer a)
                                      (ni nil :mistake ,mistake2 :hint ,hint2-num :answer (:eval (* n1 n2))))
                    :hint trans-hint
                    :mistake trans-mistake))
     (doi (make-instance 'o:transformation
                    :old-tree (o::c t '((b a n2) * n1))
                    :new-tree `(m (a nil (m (ni nil :mistake ,mistake1 :hint ,hint1-num :answer n1 :input-location :above)
                                                (oi nil :mistake ,mistake1 :hint ,hint1-op :answer "*" :input-location :above)
                                                (a nil b)))
                                      (oi nil :mistake ,mistake2 :hint ,hint2-op :answer a)
                                      (ni nil :mistake ,mistake2 :hint ,hint2-num :answer (:eval (* n1 n2))))
                    :hint trans-hint
                    :mistake trans-mistake)))))

(define-transformation reorder-2
  (macrolet ((hint1 (thing)
               `(h "Enter a number to complete a box."
                   ("Click this box and type ~a." ,thing)
                   ("How many times is the the input box multiplied in the original diagram? Click this box and type ~a." ,thing)))
             (hint2 (n1 n2)
               `(h "Enter a number to complete a box."
                   ("Click this box and type ~a." (* ,n1 ,n2))
                   ("What happens to the ~a in the original box when it is multiplied by ~a? Click this box and type ~a." ,n2 ,n1 (* ,n1 ,n2)))))
    (let ((trans-hint (h "Click some boxes and an operator."
                         "Click the boxes pointed to by the green arrows and select Multiply Additive Input."
                         "When + or - box feeds into a * box you can reorder these boxes by multiplying the values in the * box. Click the boxes pointed to by the green arrows and select Multiply Additive Input."))
          (trans-mistake (h "You cannot apply that operation to those boxes."
                            "You cannot apply that operation to those boxes."
                            "These boxes cannot be reordered. They do not involve a + or - box feeding into a * box.")))
      (labels ((rule (source dest &key (hint trans-hint) (mistake trans-mistake) hints (plists (loop for i in hints
                                                                                                  collect `(:mistake ,(basic-mistake) :hint ,i))))
                 (apply 'o::add-plists
                        (doi (o::rule source dest :hint hint :mistake mistake))
                        plists)))
        (list
         (rule '(n1 * (n2 + b))
               '((:eval * n1 n2) + (n1 * b))
               :hints `(,(hint2 n1 n2) ,(hint1 n1)))
         (rule '(n1 * (b + n2))
               '((n1 * b) + (:eval * n1 n2))
               :hints `(,(hint2 n1 n2) ,(hint1 n1)))
         (rule '((n2 + b) * n1)
               '((:eval * n1 n2) + (n1 * b))
               :hints `(,(hint2 n1 n2) ,(hint1 n1)))
         (rule '((b + n2) * n1)
               '((n1 * b) + (:eval * n1 n2))
               :hints `(,(hint2 n1 n2) ,(hint1 n1)))

         (rule '(n1 * (n2 - b))
               '((:eval * n1 n2) + ((:eval - n1) * b))
               :hints `(,(hint2 n1 n2) ,(hint1 (- n1))))
         (rule '(n1 * (b - n2))
               '((n1 * b) + (:eval * n1 (- n2)))
               :hints `(,(hint2 n1 (- n2)) ,(hint1 n1)))
         (rule '((n2 - b) * n1)
               '((:eval * n1 n2) + ((:eval - n1) * b))
               :hints `(,(hint2 n1 n2) ,(hint1 (- n1))))
         (rule '((b - n2) * n1)
               '((n1 * b) + (:eval * n1 (- n2)))
               :hints `(,(hint2 n1 (- n2)) ,(hint1 n1))))))))

(define-transformation nd-x-combine-transformations
  (labels ((transpose (op intermediate hint mistake)
             (loop for i in (list `((n1 * b) ,op (n2 * b))
                                  `((n1 * b) ,op (b * n2))
                                  `((b * n1) ,op (n2 * b))
                                  `((b * n1) ,op (b * n2)))
                collect (doi (make-instance 'o:transformation
                                       :old-tree (o::c t i)
                                       :new-tree intermediate
                                       :hint hint
                                       :mistake mistake)))))
    (let ((hint (h "Click some boxes and an operator."
                   "Click the boxes pointed to by the green arrows and select Collect Like Inputs."
                   "The same value from the top reaches a lower box by two routes. Click the boxes pointed to by the green arrows and select Collect Like Inputs."))
          (mistake (h "You cannot apply an operator to these boxes."
                      "You cannot apply an operator to these boxes."
                      "These boxes cannot be switched. They are not connected boxes that involve addition and subtraction.")))
      (nconc
       (transpose '+
                  `(m (ni nil
                          :mistake ,(h ""
                                       "No."
                                       "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                          :hint ,(h
                                  "Enter a number to complete a box."
                                  ("Type ~a." (+ n1 n2))
                                  ("~a times the top box was added to ~a times time the top box. How many times the top box is that? Type ~a." n1 n2 (+ n1 n2)))
                          :answer (:eval (+ n1 n2)))
                      (oi nil
                          :mistake ,(h ""
                                       "No."
                                       "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                          :hint ,(h
                                  "Enter an operator to complete a box."
                                  "Type *."
                                  "Copy the multiplication operator. Type *.")
                          :answer "*")
                      (a nil (m (a nil))))
                  hint
                  mistake)
       (transpose '-
                  `(m (ni nil
                          :mistake ,(h ""
                                       "No."
                                       "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                          :hint ,(h
                                  "Enter a number to complete a box."
                                  ("Type ~a." (- n1 n2))
                                  ("~a times the top box was subtracted from ~a times the top box. How many times the top box remains? Type ~a." n2 n1 (- n1 n2)))
                          :answer (:eval (- n1 n2)))
                      (oi nil
                          :mistake ,(h ""
                                       "No."
                                       "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                          :hint ,(h
                                  "Enter an operator to complete a box."
                                  "Type *."
                                  "Copy the multiplication operator. Type *.")
                          :answer "*")
                      (a nil (m (a nil))))
                  hint
                  mistake)))))

(define-transformation nd-x-weird-combine-transformations
  (macrolet ((transpose (list)
               `(loop for i in ,list
                   collect (doi (make-instance 'o:transformation
                                          :old-tree (o::c t i)
                                          :new-tree intermediate
                                          :hint hint
                                          :mistake mistake)))))
    (labels ((transpose1 (op &key intermediate hint mistake)
               (transpose (list `((n1 * b) ,op b)
                                `((b * n1) ,op b))))
             (transpose2 (op &key intermediate hint mistake)
               (transpose (list `(b ,op (n1 * b))
                                `(b ,op (b * n1))))))
      (let ((hint "The same value from the top reaches a lower box by two routes. Click the boxes pointed to by the green arrows and select Collect Like Inputs."))
        (append
         (transpose1 '-
                     :new-tree `(m (ni nil
                                           :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                           :hint ,(h
                                                   "Enter a number to complete the box."
                                                   ("Type ~a." (- n1 1))
                                                   ("The top box was subtracted from ~a times the top box. How many times the top box remains? Type ~a." n1 (- n1 1)))
                                           :answer (:eval (- n1 1)))
                                       (oi nil
                                           :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                           :hint ,(h
                                                   "Enter an operator to complete the box."
                                                   "Type *."
                                                   "Copy the multiplication operator. Type *.")
                                           :answer "*")
                                       (a nil (m (a nil))))
                     :hint hint)
         (transpose1 '+
                     :new-tree `(m (ni nil
                                           :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                           :hint ,(h
                                                   "Enter a number to complete the box."
                                                   ("Type ~a." (+ n1 1))
                                                   ("~a times the top box was added to the top box. How many times the top box is that? Type ~a." n1 (+ n1 1)))
                                           :answer (:eval (+ n1 1)))
                                       (oi nil
                                           :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                           :hint ,(h
                                                   "Enter an operator to complete the box."
                                                   "Type *."
                                                   "Copy the multiplication operator. Type *.")
                                           :answer "*")
                                       (a nil (m (a nil))))
                     :hint hint)
         (transpose2 '+ 
                     :new-tree `(m (ni nil
                                           :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                           :hint ,(h
                                                   "Enter a number to complete the box."
                                                   ("Type ~a." (+ n1 1))
                                                   ("The top box was added to ~a times the top box. How many times the top box is that? Type ~a." n1 (+ n1 1)))
                                           :answer (:eval (+ n1 1)))
                                       (oi nil
                                           :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                           :hint ,(h
                                                   "Enter an operator to complete the box."
                                                   "Type *."
                                                   "Copy the multiplication operator. Type *.")
                                           :answer "*")
                                       (a nil (m (a nil))))
                     :hint hint)
         (transpose2 '-
                     :new-tree `(m (ni nil
                                           :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                           :hint ,(h
                                                   "Enter a number to complete the box."
                                                   ("Type ~a." (- 1 n1))
                                                   ("~a times the top box was subtracted from the top box. How many times the top box is that? Type ~a." n1 (- 1 n1)))
                                           :answer (:eval (- 1 n1)))
                                       (oi nil
                                           :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                           :hint ,(h
                                                   "Enter an operator to complete the box."
                                                   "Type *."
                                                   "Copy the multiplication operator. Type *.")
                                           :answer "*")
                                       (a nil (m (a nil))))
                     :hint hint)
         (list
          (doi (make-instance 'o:transformation
                              :old-tree '(m (a nil b) (a +) (a nil b) :selected t)
                              :new-tree `(m (i nil :hint ,(h "Enter a number to complete the box."
                                                                 "Type 2"
                                                                 "The box is added to itself. Type 2.")
                                                   :mistake ,(h "" "No." "No, look at the Last Diagram State etc")
                                                   :answer 2)
                                                (oi nil
                                                    :hint ,(h "Enter an operator to complete the box."
                                                              "Type *."
                                                              "There are 2 boxes so type *.")
                                                    :mistake ,(h "" "No." "No, look at the Last Diagram State etc")
                                                    :answer "*")
                                                (a nil b))
                              :hint hint))))))))

(define-transformation nd-subtract-transformations ()
  (list
   (doi (make-instance 'o:transformation
                  :old-tree '(m (a nil b1 b2) :selected t)
                  :new-tree `(m (i nil (m (a nil b1) (oi nil
                                                             :mistake ,(h "" "No." "No, look at the Last Diagram State area to see what happens when 1 is passed through your diagram. It produces a different number at the bottom than the original diagram.")
                                                             :hint ,(h "Enter an operator to complete the box."
                                                                       "Type -."
                                                                       "The two boxes fed into the same tile so we can subtract them. Type -.")
                                                             :answer "-"
                                                             :input-location :above)
                                            (a nil b2))
                                       :hint ,(h "Enter a number to complete the box."
                                                 "Type 0."
                                                 "The two boxes are equal so when they are subtracted the result is 0. Type 0.")
                                       :mistake ,(h "" "That is the wrong number." "That is the wrong number.")
                                       :answer "0"))
                  :hint (h "Click a box and an operator."
                           "Click the box pointed to by the green arrow and select Subtract."
                           "When two boxes feed into the same tile you can subtract them. Click the box pointed to by the green arrow and select Subtract.")
                  :surgeryp nil))))

